Star Trek Starfleet Academy Mini Omnipedia/MINI_OMNI.ISO/pc/omni_v2.dxr/00403_Constructors for cleaning FT indexes.ls

Text File | 1996-04-15 | 8.9 KB | 287 lines

on hAllCheckforPlurals
  hCheckforPlurals("FT_ENCY_S", 1)
  hCheckforPlurals("FT_ENCY_S2", 1)
  hCheckforPlurals("FT_ENCY_T", 1)
  hCheckforPlurals("FT_ENCY_U", 1)
  hCheckforPlurals("FT_ENCY_V", 1)
  hCheckforPlurals("FT_ENCY_W", 1)
  hCheckforPlurals("FT_ENCY_X", 1)
  hCheckforPlurals("FT_ENCY_Y", 1)
  hCheckforPlurals("FT_ENCY_Z", 1)
end

on hCheckforPlurals pTxtFile, pNumberofFiles
  hputmsg(">hCheckforPlurals begins.")
  if pNumberofFiles > 1 then
    set vFTindex to value(hReadAll(pTxtFile, pNumberofFiles))
  else
    set vFTindex to value(hReadIt(pTxtFile))
  end if
  hputmsg(">hCheckforPlurals please wait.........")
  set vNewList to [:]
  set vListtoDelete to []
  repeat with vCountCastMem = 1 to count(vFTindex)
    set vFTword to getPropAt(vFTindex, vCountCastMem)
    set vValue to value(getAt(vFTindex, vCountCastMem))
    set vCheck to vFTword & "s"
    set vPluralVAL to getaProp(vFTindex, vCheck)
    if voidp(vPluralVAL) then
      set vCheck to vFTword & "es"
      set vPluralVAL to getaProp(vFTindex, vCheck)
      if voidp(vPluralVAL) then
        if char the number of chars in vFTword of vFTword = "y" then
          set vCheck to char 1 to the number of chars in vFTword - 1 of vFTword & "ies"
          set vPluralVAL to getaProp(vFTindex, vCheck)
        end if
      end if
    end if
    if vPluralVAL <> 0 then
      repeat with x = 1 to count(vPluralVAL)
        set vThat to getPropAt(vPluralVAL, x)
        set vThis to getAt(vPluralVAL, x)
        set vDELETEME to getPos(vFTindex, vPluralVAL)
        set vIsAMatch to getaProp(vValue, vThat)
        if vIsAMatch <> 0 then
          set vMatchProp to string(vThis) & "," & string(vIsAMatch)
          set vThis to vMatchProp
        end if
        sort(vValue)
        setaProp(vValue, vThat, vThis)
        set vPos to 0
      end repeat
    end if
    addProp(vNewList, vFTword, vValue)
    if vDELETEME <> 0 then
      add(vListtoDelete, vDELETEME)
    end if
    set vDELETEME to 0
  end repeat
  if vListtoDelete <> 0 then
    set vFinallist to [:]
    set vcounter to 0
    hputmsg("Deleting NOW! wait a minute")
    repeat with vX = 1 to count(vNewList)
      set vNewFTword to getPropAt(vNewList, vX)
      set vNewValue to value(getAt(vNewList, vX))
      set vNotThisOne to getOne(vListtoDelete, vX)
      if vNotThisOne = 0 then
        addProp(vFinallist, vNewFTword, vNewValue)
        hputmsg("adding" && vNewFTword)
      else
        hputmsg("                   Deleting" && vNewFTword)
      end if
      set vNotThisOne to 0
    end repeat
    writeIt(string(vFinallist), pTxtFile & "_NEW")
  end if
end

on hCheckforPluralsInCast pFirstCast, pLastCast
  hputmsg(">hCheckforPlurals begins.")
  repeat with vcastNum = pFirstCast to pLastCast
    set vFTindex to value(field vcastNum)
    hputmsg(">hCheckforPlurals please wait.........")
    set vNewList to [:]
    set vListtoDelete to []
    repeat with vCountCastMem = 1 to count(vFTindex)
      set vFTword to getPropAt(vFTindex, vCountCastMem)
      set vValue to value(getAt(vFTindex, vCountCastMem))
      set vCheck to vFTword & "s"
      set vPluralVAL to getaProp(vFTindex, vCheck)
      if voidp(vPluralVAL) then
        set vCheck to vFTword & "es"
        set vPluralVAL to getaProp(vFTindex, vCheck)
        if voidp(vPluralVAL) then
          if char the number of chars in vFTword of vFTword = "y" then
            set vCheck to char 1 to the number of chars in vFTword - 1 of vFTword & "ies"
            set vPluralVAL to getaProp(vFTindex, vCheck)
          end if
        end if
      end if
      if vPluralVAL <> 0 then
        repeat with x = 1 to count(vPluralVAL)
          set vThat to getPropAt(vPluralVAL, x)
          set vThis to getAt(vPluralVAL, x)
          set vDELETEME to getPos(vFTindex, vPluralVAL)
          set vIsAMatch to getaProp(vValue, vThat)
          if vIsAMatch <> 0 then
            set vMatchProp to string(vThis) & "," & string(vIsAMatch)
            set vThis to vMatchProp
          end if
          sort(vValue)
          setaProp(vValue, vThat, vThis)
          set vPos to 0
          hputmsg(x)
        end repeat
      end if
      addProp(vNewList, vFTword, vValue)
      if vDELETEME <> 0 then
        add(vListtoDelete, vDELETEME)
      end if
      set vDELETEME to 0
    end repeat
    if vListtoDelete <> 0 then
      set vFinallist to [:]
      set vcounter to 0
      hputmsg("Deleting NOW! wait a minute")
      repeat with vX = 1 to count(vNewList)
        set vNewFTword to getPropAt(vNewList, vX)
        set vNewValue to value(getAt(vNewList, vX))
        set vNotThisOne to getOne(vListtoDelete, vX)
        if vNotThisOne = 0 then
          addProp(vFinallist, vNewFTword, vNewValue)
        else
          hputmsg("                   Deleting" && vNewFTword)
        end if
        set vNotThisOne to 0
      end repeat
      set vName to the name of cast vcastNum
      put string(vFinallist) into field vcastNum
      set the name of cast vcastNum to vName & "_NEW"
    end if
  end repeat
end

on hReadAll pTxtFile, pNumberofFiles
  set gTheFile to [:]
  set gEntireNameList to [:]
  set vThisFile to [:]
  repeat with x = 1 to pNumberofFiles
    set vThisFile to value(hReadIt(pTxtFile & x))
    if not objectp(vThisFile) then
      hputmsg(" ******* list is messed up it is not a list *******")
    end if
    repeat with p = 1 to count(vThisFile)
      addProp(gEntireNameList, getPropAt(vThisFile, p), getAt(vThisFile, p))
    end repeat
  end repeat
  hputmsg("hReadAll a file named " & pTxtFile & x & "******************" & RETURN)
  return gEntireNameList
end

on hputtheseinCAST whichmode
  repeat with thischar = charToNum("A") to charToNum("D")
    set alph to numToChar(thischar)
    hReadinFt("FT" & whichmode & alph)
  end repeat
end

on hCheckallforSingles whichmode
  repeat with thischar = charToNum("A") to charToNum("Z")
    set alph to numToChar(thischar)
    set var to "FT" & whichmode & alph
    hCheckforSingles(var)
  end repeat
end

on hCheckforSingles thisCastMem
  set temp to [:]
  set thisList to [:]
  set listDups to [:]
  set temp to the text of cast thisCastMem
  set temp to value(temp)
  sort(temp)
  repeat with p = 1 to count(temp)
    set vProp to getPropAt(temp, p)
    set vValue to getAt(temp, p)
    if count(vValue) > 1 then
      addProp(thisList, vProp, vValue)
      next repeat
    end if
  end repeat
  sort(thisList)
  set the text of cast thisCastMem to string(thisList)
end

on hReadinFt readthisName
  set gTheFile to [:]
  set gReadObject to FileIO(mnew, "read", the pathName & readthisName)
  set vTheFile to gReadObject(mReadLine)
  gReadObject(mdispose)
  set the text of cast readthisName to string(vTheFile)
  hputmsg("Read a file named " & readthisName & "******************" & RETURN)
end

on hReadFileoffHD readthisName, thiscastnumber
  set vTheFile to [:]
  set gReadObject to FileIO(mnew, "read", the pathName & readthisName)
  hputmsg("the pathname&thisName =" & the pathName & readthisName)
  set vTheFile to gReadObject(mReadLine)
  gReadObject(mdispose)
  set the text of cast thiscastnumber to string(vTheFile)
  set the name of cast thiscastnumber to string(readthisName)
  hputmsg("Read a file named " & readthisName & "******************" & RETURN)
end

on hRunAll
  hReadFileoffHD("FT_ENCY_X" & "_NEW", 866)
  hReadFileoffHD("FT_ENCY_Y" & "_NEW", 867)
  hReadFileoffHD("FT_ENCY_Z" & "_NEW", 868)
end

on hSortThisCast pStart, pStop
  repeat with j = pStart to pStop
    set lk to [:]
    set lk to value(field j)
    if not objectp(lk) then
      beep()
      put "Field" && j && "is not a legal list."
      abort()
    end if
    put "Got field" && j && "with" && count(lk) && "items."
    sort(lk)
    put lk into field j
    put "...sorted and replaced"
  end repeat
  put "hSortThisCast complete."
end

on hsimplyverify pStart, pStop
  repeat with j = pStart to pStop
    set lk to value(field j)
    if not objectp(lk) then
      beep()
      put "Field" && j && "is not a legal list."
      next repeat
    end if
    put "Field" && j && "has" && count(lk) && "items" && the name of cast j
  end repeat
  put "hsimplyverify complete."
end

on hShowCastList pFirstCast, pLastCast
  repeat with i = pFirstCast to pLastCast
    if not (the name of cast i contains "blank") then
      set vNumofChar to the size of cast i
      set vTemp to the number of cast i & "   " & the name of cast i & "   " & vNumofChar
      set gHold to gHold & RETURN & vTemp
    end if
  end repeat
  put gHold
end

on hshowfirstlast pFirstCast, pLastCast
  repeat with i = pFirstCast to pLastCast
    set k to value(field i)
    if not objectp(k) then
      put "Cast" && the name of cast i && "is not a list"
      next repeat
    end if
    if count(k) > 0 then
      put "Cast" && i && the name of cast i && getPropAt(k, 1) && getPropAt(k, count(k))
    end if
  end repeat
  put "finished"
end

on hFTTest pWhat
  set t to the ticks
  put "Running..."
  repeat with i = 1 to 1000
    set Lpointer to hCapitalize(char 1 of pWhat)
    hSubdivideFTpointer(Lpointer, pWhat)
  end repeat
  set t to the ticks - t
  put "That took" && t && "ticks."
end